SuperHack/SuperHack CD.bin/CODING/PASCAL/ALLSWAGS.ZIP/SWAGG-M.ZIP/MISC.SWG/0192_Card Game of Spite & Malice.pas

Pascal/Delphi Source File | 1996-11-29 | 58.6 KB | 1,934 lines

{_____________________________________________________________________________
|  Filename: CODE.PAS
|     Title: Spite & Malice
|  Written By: Benjamin Arnoldy and Raechel Kula
|_____________________________________________________________________________
|  Contents:
|    The procedures: Deal, WhoseTurn, PickupCards, Decision, GetMove,
|                    CheckMove, MoveCard
|    Oject: Pile
|_____________________________________________________________________________
|  Synopsis:
|    This program allows the user to select either another person, or the
     computer as the opponent, then play the opponent in the card game
|    Spite & Malice.  The interface is textual.
|_____________________________________________________________________________
|  Description:
|    No references at this time.
|_____________________________________________________________________________
|  Environment:
|    TurboPASCAL for the PC.
|_____________________________________________________________________________
|  Version History:
|
|  Version 5.1 -- May 8, 1996
|              Raechel Kula & Benjamin Arnoldy
|              Improved interface and Decision.
|
|  Version 5.0 -- May 7, 1996
|              Raechel Kula & Benjamin Arnoldy
|              Code is cleaned up and ready for presentation.
|
|  Version 4.3 -- May 6, 1996
|               Raechel Kula & Benjamin Arnoldy
|               Additional testing, more tinkering with weights.
|
|  Version 4.2 -- May 5, 1996
|               Raechel Kula & Benjamin Arnoldy
|               Added provisions in decision for jokers.
|
|  Version 4.1 -- May 4, 1996
|                Raechel Kula & Benjamin Arnoldy
|                Testing and tinkering with weights to make
|                the computer a better opponent.
|
|  Version 4.0 -- May 3, 1996
|                Raechel Kula & Benjamin Arnoldy
|                An "operable" Decision procedure is
|                in place.
|
|  Version 3.1 -- May 2, 1996
|                Raechel Kula & Benjamin Arnoldy
|                Various Embellishments to make it an operable
|                2 player game (e.g. end of game stuff).
|
|  Version 3.0 -- May 1, 1996
|                 Raechel Kula & Benjamin Arnoldy
|                 Ascii Graphical Interface is instituted.
|
|  Version 2.9 -- April 30, 1996
|                 Raechel Kula & Benjamin Arnoldy
|                 Small display functions (CardString) coded.
|
|  Version 2.2 -- April 28, 1996
|                  Raechel Kula & Benjamin Arnoldy
|                  CheckMove procedure ironed out.
|
|   Version 2.1 -- April 26, 1996
|                  Raechel Kula & Benjamin Arnoldy
|                  Basic Main Program Procedures Modified to fit with new
|                  object structure.
|
|   Version 2.0 -- April 25, 1996
|                  Raechel Kula & Benjamin Arnoldy
|                   Object Pile Coded.
|
|    MidApril -- Meeting with Prof Squier & Subsequent Major Rethinking
|
|    Version 1.1 -- Apr. 7, 1996
|                   Raechel Kula & Benjamin Arnoldy
|                     Pieces of Decision and CheckMove procedures are
|                     completed.
|
|    Version 1.0 -- Mar. 29, 1996
|                   Raechel Kula & Benjamin Arnoldy
|                     WhoseTurn, PickupCards, MoveCard procedures are coded.
|                     The code successfully compiles.
|
|    Version 0.2 -- Mar. 12, 1996
|                   Raechel Kula & Benjamin Arnoldy
|                     Deal and GetMove procedures are coded.
|
|    Version 0.2 -- Mar. 5, 1996
|                   Raechel Kula & Benjamin Arnoldy
|                     GetValue and GetPlace procedures are coded.
|
|    Version 0.1 -- Feb. 30, 1996
|                   Raechel Kula & Benjamin Arnoldy
|                     Main Program and Stubs
|    Version 0.0
|____________________________________________________________________________}

program SpiteMalice;

uses CRT;

{=============================================================================
                                   CONSTANTS
=============================================================================}

const DRAWPILE_MAX = 108;
      HAND_MAX = 6;
      SCOREPILE_MAX = 14;
      DISCARDPILE_MAX = 108;
      ACEPILE_MAX = 13;
      TRASHPILE_MAX = 108;
      MAXSIZE = 108;
      NULL = -1;

{=============================================================================
                                     TYPES
=============================================================================}

type CardVal_t = integer;
     Pos_t = integer;
     CardArray_t = array [1..108] of CardVal_t;
     CardValTable_t = array [1..26] of CardVal_t;
     choiceTable_t = array [1..26, 1..19] of integer;

{=============================================================================
                              OBJECT DECLARATION
=============================================================================}

type Pile = object
   {public}
   procedure Init;
   procedure RandomShuffle;
   procedure PutOnTop (CardtoPutOn: CardVal_t);
   function RemoveFromTop: CardVal_t;
   function SeeRandom (Pos: Pos_t): CardVal_t;
   function DeleteByValue (value : CardVal_t): CardVal_t;
   function IsPresent (CardtoFind: CardVal_t): boolean;
   function NumCards: integer;

   private

   data: CardArray_t;
   top: Pos_t;  {top = slot with top card in it.}

end; {Object declaration}

{=============================================================================
                         OBJECT DEPENEDENT TYPES
=============================================================================}

Type pilepointer_t = ^Pile;
     stack_t = array [1..26] of pilepointer_t;

{=============================================================================
                                GLOBAL VARIABLES
=============================================================================}

var DrawPile: Pile;
    PlayerHand: Pile;
    ComputerHand: Pile;
    PlayerScorePile: Pile;
    ComputerScorePile: Pile;
    PlayerDiscardPile1: Pile;
    PlayerDiscardPile2: Pile;
    PlayerDiscardPile3: Pile;
    PlayerDiscardPile4: Pile;
    ComputerDiscardPile1: Pile;
    ComputerDiscardPile2: Pile;
    ComputerDiscardPile3: Pile;
    ComputerDiscardPile4: Pile;
    AcePile1: Pile;
    AcePile2: Pile;
    AcePile3: Pile;
    AcePile4: Pile;
    TrashPile: Pile;
    ComputerTurn: boolean;
    Game: boolean;
    Valid, Discard, DecisionDiscard: boolean;
    From, Tto: integer;
    PosTable : stack_t;
    TopCardTable: CardValTable_t;
    pos: integer;
    Winner: string;
    ChoiceRate: choiceTable_t;
    AnotherGame: boolean;
    TwoPlayer: boolean;
    MustMove: boolean;

{=============================================================================
                       OBJECT PROCEDURES & FUNCTIONS
=============================================================================}

{____________________________________________________________________
| Init
|       Initializes a pile's array (data) and pointer (top)
|___________________________________________________________________}

procedure Pile.Init;

var Count: integer;

begin
   top := MAXSIZE + 1;
   for Count := 1 to MAXSIZE do
      Pile.PutOnTop (NULL);   {Stores NULL values in entire array.}
   top := MAXSIZE + 1;
end; {procedure Init}

{____________________________________________________________________
| RandomShuffle
|         Shuffles the cards in a pile.
|___________________________________________________________________}

procedure Pile.RandomShuffle;

var ShuffleArray: Pile;  {Temporary Storage Pile}
    Counter: Pos_t;
    RandSlot: integer;
    DeckSize: integer;
    TopofDeck: Pos_t;

begin
   DeckSize := DrawPile.NumCards;
   TopofDeck := (MAXSIZE - DeckSize) + 1;
   ShuffleArray.Init;   {Initializing ShuffleArray}
   ShuffleArray.top := TopofDeck;
   for Counter := 1 to DeckSize do begin
      RandSlot := Random (DeckSize) + 1;  {'+1' due to Random range.}
      While ShuffleArray.SeeRandom (RandSlot) <> NULL do
         RandSlot := Random (DeckSize) + 1;
      ShuffleArray.top := TopofDeck + Randslot;
         {Set ShuffleArray's "top" pointer to slot beneath empty slot, so
          that PutOnTop will put the card in the empty slot.}
      ShuffleArray.PutOnTop (DrawPile.RemoveFromTop);
      ShuffleArray.top := TopofDeck;
   end; {for}
   ShuffleArray.top := TopofDeck;
      {Set ShuffleArray's "top" pointer to the top of the stack.}
   for Counter := 1 to DeckSize do
      DrawPile.PutOnTop (ShuffleArray.RemoveFromTop);
   {Transfered shuffled ShuffleArray to DrawPile.}
end; {Procedure RandomShuffle}

{____________________________________________________________________
| PutOnTop
|      Places a card value on the top of the pile.
|
|___________________________________________________________________}

procedure Pile.PutOnTop (CardtoPutOn: CardVal_t);

begin
   top := top - 1; {Advance the top pointer to the empty slot above it.}
   If top < 0 then begin
      writeln ('ERROR. Array Overflow.');
      HALT;
      {Program is stopped if program attempts to a put a card on top of what
       should be a full pile.  This should never never happen given that the
       size of the pile arrays are the same size as the number of cards.}
   end;
   data [top] := CardtoPutOn;
end; {procedure PutOnTop}

{____________________________________________________________________
| RemoveFromTop
|      Removes the top card from a pile and return the value of
|      of the card.
|___________________________________________________________________}

function Pile.RemoveFromTop: CardVal_t;

begin
   RemoveFromTop := data [top];
   data [top] := NULL;
   top := top + 1; {Adjusts the top pointer so it points at the top card.}
end; {Procedure RemoveFromTop}

{____________________________________________________________________
| SeeRandom
|      Allows the program to view the card value in any given
|      position in a stack.
|___________________________________________________________________}

function Pile.SeeRandom (pos: Pos_t): CardVal_t;

begin
   SeeRandom := data [top + pos - 1];
      {The "- 1" in the equation defines position 1 as the top card.}
   if (top + pos - 1) > MAXSIZE then
      SeeRandom := NULL;
   {if the seek excedes the boundaries, a null value is returned.}
end; {Procedure SeeRandom}

{____________________________________________________________________
|  DeleteByValue
|       Searches through a pile for a designated value, and "pulls"
|       the card out, returning the card's value.  After the card is
|       removed, the gap in the stack is filled in by readjusting the
|       cards.
|___________________________________________________________________}

function Pile.DeleteByValue (value : CardVal_t): CardVal_t;

var count:integer; hold : CardVal_t;

begin
   count:=0;
   Repeat
      count :=count+1;
   Until (data[count] = value);
   hold := data[top];
   data[top] := value;
   data[count] := hold;
   hold := Pile.RemoveFromTop;
end; {Procedure DeleteByValue}

{____________________________________________________________________
| IsPresent
|      Searches through a pile, looking to see if a designated card
|      value is present.
|___________________________________________________________________}

function Pile.IsPresent (CardtoFind: CardVal_t): boolean;

var
   ValuePresent: boolean;

begin
   ValuePresent := FALSE;
   while ((ValuePresent = FALSE) OR (top > MAXSIZE)) do begin
      top := top + 1;
      If data [top] = CardtoFind then
         ValuePresent := TRUE;
      end; {While}
      If ValuePresent = FALSE then
         IsPresent := FALSE
      else
         IsPresent := TRUE;
end; {Function IsPresent}

{____________________________________________________________________
|  NumCards
|      Returns the number of cards in a pile.
|___________________________________________________________________}

function Pile.NumCards: integer;

begin
   NumCards := (MAXSIZE - top) + 1;
      {The "+ 1" in the equation takes into account that the position of top
       contains a card.}
end; {function NumCards}

{============================================================================
                               GENERAL FUNCTIONS
============================================================================}

{____________________________________________________________________
|  CardValue
|     Converts card value (4..111) to orderinal value.
|     (0 = Joker, 1,2,3,...10,11 = JACK,...)
|___________________________________________________________________}

function CardValue (Card: CardVal_t): integer;

begin
   if Card = NULL then
      CardValue := NULL
   else
      CardValue := Card DIV 8;
end; {function CardValue}

{____________________________________________________________________
|  CardString
|     Converts a card value to a string, for representation on the
|     screen.
|___________________________________________________________________}

function CardString (Card: CardVal_t): string;
var
   Number: integer;
   Output: string;

begin
   Number := Card DIV 8;
   if Card = NULL then Output := '' else
   if Number = 0 then Output := 'JO' else
   if Number = 1 then Output := 'AC' else
   if Number = 2 then Output := '02' else
   if Number = 3 then Output := '03' else
   if Number = 4 then Output := '04' else
   if Number = 5 then Output := '05' else
   if Number = 6 then Output := '06' else
   if Number = 7 then Output := '07' else
   if Number = 8 then Output := '08' else
   if Number = 9 then Output := '09' else
   if Number = 10 then Output := '10' else
   if Number = 11 then Output := 'JA' else
   if Number = 12 then Output := 'QU' else
   if Number = 13 then Output := 'KI' else
   Output := 'ERROR';

   Number := Card MOD 4;
   if Card = NULL then Output := '' else
   if (Card DIV 8) = 0 then Output := Output + '!' else
   if Number = 0 then Output := Output + chr(3) else
   if Number = 1 then Output := Output + chr(4) else
   if Number = 2 then Output := Output + chr(5) else
   if Number = 3 then Output := Output + chr(6) else
   Output := 'ERROR';

   CardString := Output;

end; {function CardSuit}

{___________________________________________________________________
|  AceTopCard
|     Due to the possibility of a joker on an ace pile, this
|     function returns the ordinal value of the card on the top of
|     an ace pile -- if there's a joker it is converted to its
|     ordinal value within the pile.
|___________________________________________________________________}

function AceTopCard (Number: integer): integer;

var position: integer;

begin
   position := 1;
   while (CardValue (PosTable [Number]^.SeeRandom (position)) = 0) do
      position := position + 1;
   AceTopCard := CardValue (PosTable [Number]^.SeeRandom (position)) +
                 position - 1;
end; {function AceTopCard}

{============================================================================
                             MAIN PROGRAM PROCEDURES
                   (Grouped with corresponding sub-procedures)
============================================================================}

{___________________________________________________________________
|  Initialize
|      Does all the Non-Object initialization.
|__________________________________________________________________}

procedure Initialize;

var count:integer;

begin
   Randomize;
   DrawPile.Init;
   PlayerHand.Init;
   ComputerHand.Init;
   PlayerScorePile.Init;
   ComputerScorePile.Init;
   PlayerDiscardPile1.Init;
   PlayerDiscardPile2.Init;
   PlayerDiscardPile3.Init;
   PlayerDiscardPile4.Init;
   ComputerDiscardPile1.Init;
   ComputerDiscardPile2.Init;
   ComputerDiscardPile3.Init;
   ComputerDiscardPile4.Init;
   AcePile1.Init;
   AcePile2.Init;
   AcePile3.Init;
   AcePile4.Init;
   TrashPile.Init;
   Game := TRUE;

   {Set up Position Table}

   PosTable[1] := @PlayerHand;
   PosTable[2] := @PlayerHand;
   PosTable[3] := @PlayerHand;
   PosTable[4] := @PlayerHand;
   PosTable[5] := @PlayerHand;
   PosTable[6] := @PlayerHand;
   PosTable[7] := @PlayerScorePile;
   PosTable[8] := @PlayerDiscardPile1;
   PosTable[9] := @PlayerDiscardPile2;
   PosTable[10] := @PlayerDiscardPile3;
   PosTable[11] := @PlayerDiscardPile4;
   PosTable[12] := @AcePile1;
   PosTable[13] := @AcePile2;
   PosTable[14] := @AcePile3;
   PosTable[15] := @AcePile4;
   PosTable[16] := @ComputerDiscardPile1;
   PosTable[17] := @ComputerDiscardPile2;
   PosTable[18] := @ComputerDiscardPile3;
   PosTable[19] := @ComputerDiscardPile4;
   PosTable[20] := @ComputerHand;
   PosTable[21] := @ComputerHand;
   PosTable[22] := @ComputerHand;
   PosTable[23] := @ComputerHand;
   PosTable[24] := @ComputerHand;
   PosTable[25] := @ComputerHand;
   PosTable[26] := @ComputerScorePile;

end; {procedure Initialize}

{___________________________________________________________________
|  InitTable
|     Refreshes the values for the TopCardTable, which stores the
|     values of the top card in all 26 positions.
|__________________________________________________________________}

procedure InitTable;

var count:integer;

begin
   for count := 1 to 6 Do
      TopCardTable[count] := PosTable[count]^.SeeRandom (count);
   for count := 7 to 19 Do
      TopCardTable[count] := PosTable[count]^.SeeRandom (1);
   for count := 20 to 25 Do
      TopCardTable[count] := PosTable[count]^.SeeRandom(count-19);
   TopCardTable[26] := PosTable[26]^.SeeRandom(1);
end; {procedure InitTable}

{___________________________________________________________________
|  Deal
|    Deals the cards at the beginning of each game and decides,
|    based on the outcome of the deal, who will go first.
|__________________________________________________________________}

procedure Deal;

var Card: CardVal_t;
    Counter: integer;
    PlayerScoreTop: CardVal_t;
    ComputerScoreTop: CardVal_t;

begin
   for Card := (1 +3) to (MAXSIZE +3) do
      {Put 2 decks of cards in draw pile, +3 is necessary for the div and mod
       to operate correctly.}
      DrawPile.PutOnTop (Card);
   DrawPile.RandomShuffle;  {Shuffle the draw pile.}
   for Counter := 1 to 5 do begin {Deal the hands}
      PlayerHand.PutOnTop (DrawPile.RemoveFromTop);
      ComputerHand.PutOnTop (DrawPile.RemoveFromTop);
   end; {for}
   for Counter := 1 to 14 do begin {Deal the score piles}
      PlayerScorePile.PutOnTop (DrawPile.RemoveFromTop);
      ComputerScorePile.PutOnTop (DrawPile.RemoveFromTop);
   end; {for}
   PlayerDiscardPile1.PutOnTop (DrawPile.RemoveFromTop);
   PlayerDiscardPile2.PutOnTop (DrawPile.RemoveFromTop);
   PlayerDiscardPile3.PutOnTop (DrawPile.RemoveFromTop);
   PlayerDiscardPile4.PutOnTop (DrawPile.RemoveFromTop);
   ComputerDiscardPile1.PutOnTop (DrawPile.RemoveFromTop);
   ComputerDiscardPile2.PutOnTop (DrawPile.RemoveFromTop);
   ComputerDiscardPile3.PutOnTop (DrawPile.RemoveFromTop);
   ComputerDiscardPile4.PutOnTop (DrawPile.RemoveFromTop);
        {Decide whose turn it is.  ComputerTurn set to opposite, because
         it will be reversed in upcoming WhoseTurn procedure.}
   PlayerScoreTop := CardValue (PlayerScorePile.SeeRandom(1));
   ComputerScoreTop := CardValue (ComputerScorePile.SeeRandom(1));

   if PlayerScoreTop = 0 then
      ComputerTurn := FALSE
   else if ComputerScoreTop = 0 then
      ComputerTurn := TRUE
   else if PlayerScoreTop = ComputerScoreTop then
      ComputerTurn := FALSE
   else if PlayerScoreTop > ComputerScoreTop then
      ComputerTurn := TRUE
   else
      ComputerTurn := FALSE;

end; {Deal}

{___________________________________________________________________
|  OutString
|     One of the procedures involving the interface.
|     This procedure receives x,y coordinates for a screen position
|     and outputs a string starting at that position.
|__________________________________________________________________}

procedure OutString (x,y: integer; toPrint: string);

begin
   GotoXY (x,y);
   write (toPrint);
end; {procedure OutString}

{____________________________________________________________________
|  ColorDim
|     One of the procedures involving the interface.
|     Sets colors for displaying things involving the player whose
|     turn it is not (hence, they are dimmed.)
|___________________________________________________________________}

procedure ColorDim;

begin
   TextColor (LIGHTgray);
   TextBackground (BLACK);
end; {procedure ColorDim}

{___________________________________________________________________
|  ColorCard
|     One of the procedures involving the interface.
|     Sets colors for displaying a card of the player whose turn it
|     is.
|___________________________________________________________________}

procedure ColorCard;

begin
   TextColor (YELLOW);
   TextBackGround (BLUE);
end; {procedure ColorCard}

{____________________________________________________________________
|  ColorFrame
|     One of the procedures involving the interface.
|     Sets colors for highlighting the section of the frame
|     involving the player whose turn it is.
|___________________________________________________________________}


procedure ColorFrame;

begin
   TextColor (YELLOW);
   TextBackground (BLACK);
end; {procedure ColorFrame}

{____________________________________________________________________
|  ColorNormalText
|     One of the procedures involving the interface.
|     Sets colors for normal text and is also the colors which the
|     game returns to upon exiting.
|___________________________________________________________________}

procedure ColorNormalText;

begin
   TextColor (WHITE);
   TextBackground (BLACK);
end; {procedure ColorNormalText}

{___________________________________________________________________
|  ColorPosition
|     One of the procedures involving the interface.
|     Sets colors for the display of position indicators.
|__________________________________________________________________}

procedure ColorPosition;

begin
   TextColor (WHITE);
   TextBackground (RED);
end; {procedure ColorPosition}

{___________________________________________________________________
|  TitleScreen
|     Displays a title screen and asks whether the user would like
|     a one-player or a two-player game.  Accompanying procedures are
|     called by TitleScreen
|__________________________________________________________________}



procedure Heart;
begin
TextColor (red);
TextBackground (LightGray);
write (char(3));
end;

procedure Club;
begin
TextColor (black);
TextBackground (LightGray);
write (char(5));
end;

procedure Diamond;
begin
TextColor (red);
TextBackground (lightgray);
write (char(4));
end;

procedure Spade;
begin
TextColor (black);
TextBackground (lightgray);
write (char(6));
end;

procedure SuitsCol (x, y, count: integer);
var c :integer;
begin
c := 0;
while (count > 0) Do begin
 GotoXY (x, y+c*4);
 Heart;
 GotoXY (x, y+c*4+1);
 Club;
 GotoXY (x, y+c*4+2);
 Diamond;
 GotoXY (x, y+c*4+3);
 Spade;
 c := c + 1;
 count := count - 1;
 TextBackGround (black);
end; {while loop}
end; {SuitsCol}

procedure SuitsRow (x, y, count: integer);
var c :integer;
begin
c := 0;
while (count > 0) Do begin
 GotoXY (x + (4*c), y);
 Heart;
 Club;
 Diamond;
 Spade;
 c := c + 1;
 count := count - 1;
 TextBackground (black);
end; {while loop}
end; {SuitsRow}

procedure DrawTitleBox;
Begin
SuitsCol (25, 7, 2);
SuitsRow (25, 7, 8);
SuitsRow (25, 15, 8);
SuitsCol (57, 7, 2);
GotoXY (57, 15);
Heart;
end; {DrawTitleBox}

procedure Title;
 begin
  TextColor (white);
  TextBackground (black);
  OutString (28, 9, 'Welcome to Spite & Malice!');
 end;


procedure Info (var TwoPlayer : boolean);
var response : char;
begin
repeat
 OutString (33, 12, 'How many players?');
 OutString (37, 13, '(');
 TextColor (lightred);
 OutString (38, 13, '1 ');
 TextColor (white);
 OutString (40, 13, 'or ');
 TextColor (lightred);
 OutString (43, 13, '2');
 TextColor (white);
 OutString (44, 13,  ')');
 GotoXY (40, 14);
 readln (response);
 until ((response = '1') OR (response = '2'));
   if response = '1' then
      TwoPlayer := FALSE
   else
      TwoPlayer := TRUE;

end;

procedure TitleScreen (var TwoPlayer:boolean);

var response: char;

Begin
TextBackground (black);
clrscr;
TextBackground (black);
DrawTitleBox;
Title;
Info (TwoPlayer);
TextBackground (black);
TextColor (white);
End; {procedure TitleScreen}

{___________________________________________________________________
|  DrawFrame
|     One of the procedures involving the interface.
|     This procedure draws the ascii graphical skeleton of the
|     screen.  It also takes into account the turn in its choice of
|     colors.
|__________________________________________________________________}

procedure DrawFrame (ComputerTurn: boolean);

var Row: integer;
    Column: integer;

begin
   {Clear screen with Black background.}
   TextBackGround (BLACK);
   TextColor (BLACK);
   For Row:= 1 to 25 do
      For Column := 1 to 80 do begin
         if NOT ((Row = 25) and (Column = 80)) then
            OutString (Column, Row, chr(219));
      end; {for column}
   if ComputerTurn = TRUE then
      ColorDim
   else
      ColorFrame;
   OutString (1,1,chr(201));
   OutString (1,24,chr(200));
   OutString (31,1,chr(203));
   OutString (31,24,chr(202));
   for Column := 2 to 30 do begin
      OutString (Column,1,chr(205));
      OutString (Column,24,chr(205));
   end; {for}
   For Row := 2 to 23 do begin
      OutString (1,Row,chr(186));
      OutString (31,Row,chr(186));
   end; {for}
   Outstring (1,18,chr(204));
   Outstring (31,18,chr(185));
   For Row := 2 to 30 do
      OutString (Row,18,chr(205));
   OutString (31,5,chr(204));
   OutString (31,13,chr(204));
   if ComputerTurn = TRUE then
      ColorFrame
   else
      ColorDim;
   For Column := 51 to 79 do begin
      OutString (Column,1,chr(205));
      OutString (Column,18,chr(205));
      OutString (Column,24,chr(205));
   end; {for}
   For Row := 2 to 23 do begin
      OutString (50,Row,chr(186));
      OutString (80,Row,chr(186));
   end; {for}
   OutString (50,1,chr(203));
   OutString (50,24,chr(202));
   OutString (50,5,chr(185));
   OutString (50,13,chr(185));
   OutString (50,18,chr(204));
   OutString (80,1,chr(187));
   OutString (80,24,chr(188));
   ColorFrame;
   For Column := 32 to 49 do begin
      OutString (Column,1,chr(205));
      OutString (Column,5,chr(205));
      OutString (Column,13,chr(205));
      OutString (Column,24,chr(205));
   end; {for}

   TextColor (BLUE);
   for Row := 2 to 4 do
      for Column := 32 to 49 do
         OutString (Column,Row,chr(219));
   TextColor (WHITE);
   TextBackground (BLUE);
   OutString (34,2,'Spite & Malice');
   OutString (34,3,'By Ben Arnoldy');
   OutString (34,4,'& Raechel Kula');
end; {procedure DrawFrame}

{___________________________________________________________________
|  DrawDiscards
|     One of the procedures involved with the interface.
|     This procedure sets up the discard portions of the screen.
|__________________________________________________________________}

procedure DrawDiscards (ComputerTurn:boolean);

var Counter: Pos_t;

begin

   if ComputerTurn = TRUE then
      ColorDim
   else
      ColorNormalText;
   OutString (9,2,'Player Discard');
   if ComputerTurn = TRUE then
      ColorNormalText
   else
      ColorDim;
   if (TwoPlayer = FALSE) then
      OutString (58,2,'Computer Discard')
   else if (TwoPlayer = TRUE) then
      OutString (58,2,'Opponent Discard');
   ColorPosition;
   OutString (3,3,'H'+chr(26));
   OutString (10,3,'I'+chr(26));
   OutString (17,3,'J'+chr(26));
   OutString (24,3,'K'+chr(26));
   OutString (52,3,'P'+chr(26));
   OutString (59,3,'Q'+chr(26));
   OutString (66,3,'R'+chr(26));
   OutString (73,3,'S'+chr(26));
   for Counter := 1 to 14 do begin
      if ComputerTurn = TRUE then
         ColorDim
      else
         ColorCard;
      OutString(6,2+Counter,
         CardString (PlayerDiscardPile1.SeeRandom(Counter)));
      OutString(13,2+Counter,
         CardString (PlayerDiscardPile2.SeeRandom(Counter)));
      OutString(20, 2+Counter,
         CardString (PlayerDiscardPile3.SeeRandom(Counter)));
      OutString(27, 2+Counter,
         CardString (PlayerDiscardPile4.SeeRandom(Counter)));
      if ComputerTurn = FALSE then
         ColorDim
      else
         ColorCard;
      OutString(55, 2+Counter,
         CardString (ComputerDiscardPile1.SeeRandom(Counter)));
      OutString(62, 2+Counter,
         CardString (ComputerDiscardPile2.SeeRandom(Counter)));
      OutString(69, 2+Counter,
         CardString (ComputerDiscardPile3.SeeRandom(Counter)));
      OutString(76, 2+Counter,
         CardString (ComputerDiscardPile4.SeeRandom(Counter)));
   end; {for}
   {if there are too many cards in a discard pile to display...}
   TextColor (LIGHTred);
   TextBackground (BLACK);
   for Counter := 1 to 4 do begin
      if PosTable [7+Counter]^.NumCards > 14 then
         OutString ((-2 + (Counter*7)),17,'more');
      if PosTable [15+Counter]^.NumCards > 14 then
         OutString ((44 + (Counter*7)),17,'more');
   end; {for}
end; {procedure DrawDiscards}

{___________________________________________________________________
|  DrawHands
|     One of the procedures involved with the interface.
|     This procedure displays the hands and scorepiles.
|__________________________________________________________________}

procedure DrawHands (ComputerTurn:boolean);

var CardFace: string;

begin

   if ComputerTurn = TRUE then
      ColorDim
   else
      ColorNormalText;
   GotoXY (2,19);
   write ('Player''s Hand:');
   if ComputerTurn = FALSE then
      ColorDim
   else
      ColorNormalText;
   if (TwoPlayer = FALSE) then begin
      GotoXY (51,19);
      write ('Computer''s Hand:');
   end
   else if (TwoPlayer = TRUE) then begin
      GotoXY (51,19);
      write ('Opponent''s Hand:');
   end;
   ColorPosition;
   OutString (3,21,'A'+chr(24));
   OutString (8,21,'B'+chr(24));
   OutString (13,21,'C'+chr(24));
   OutString (18,21,'D'+chr(24));
   OutString (23,21,'E'+chr(24));
   OutString (28,21,'F'+chr(24));
   OutString (52,21,'T'+chr(24));
   OutString (57,21,'U'+chr(24));
   OutString (62,21,'V'+chr(24));
   OutString (67,21,'W'+chr(24));
   OutString (72,21,'X'+chr(24));
   OutString (77,21,'Y'+chr(24));
   If ComputerTurn = TRUE then
      ColorDim
   else
      ColorCard;
   OutString(3,20,CardString (PlayerHand.SeeRandom(1)));
   OutString(8,20,CardString (PlayerHand.SeeRandom(2)));
   OutString(13,20,CardString (PlayerHand.SeeRandom(3)));
   OutString(18,20,CardString (PlayerHand.SeeRandom(4)));
   OutString(23,20,CardString (PlayerHand.SeeRandom(5)));
   OutString(28,20,CardString (PlayerHand.SeeRandom(6)));
   If ComputerTurn = FALSE then
      ColorDim
   else
      ColorCard;
   If TwoPlayer then begin
      OutString(52,20,CardString (ComputerHand.SeeRandom(1)));
      OutString(57,20,CardString (ComputerHand.SeeRandom(2)));
      OutString(62,20,CardString (ComputerHand.SeeRandom(3)));
      OutString(67,20,CardString (ComputerHand.SeeRandom(4)));
      OutString(72,20,CardString (ComputerHand.SeeRandom(5)));
      OutString(77,20,CardString (ComputerHand.SeeRandom(6)));
   end {if}
   else begin
      CardFace := chr(168) + chr(63);
      if ComputerHand.NumCards > 0 then
         OutString(52,20,CardFace);
      if ComputerHand.NumCards > 1 then
         OutString(57,20,CardFace);
      if ComputerHand.NumCards > 2 then
         OutString(62,20,CardFace);
      if ComputerHand.NumCards > 3 then
         OutString(67,20,CardFace);
      if ComputerHand.NumCards > 4 then
         OutString(72,20,CardFace);
      if ComputerHand.NumCards > 5 then
         OutString(77,20,CardFace);
   end; {if-else}
   if ComputerTurn = TRUE then
      ColorDim
   else
      ColorNormalText;
   GotoXY (2,23);
   write ('Score Pile: ', PlayerScorePile.NumCards,
      ' cards> ');
   ColorPosition;
   write('G'+chr(26));
   TextColor (BLACK);
   TextBackground (BLACK);
   write(' ');
   if ComputerTurn = TRUE then
      ColorDim
   else
      ColorCard;
   write (CardString (PlayerScorePile.SeeRandom(1)));
   if ComputerTurn = FALSE then
      ColorDim
   else
      ColorNormalText;
   GotoXY (51,23);
   write ('Score Pile: ', ComputerScorePile.NumCards,
      ' cards> ');
   ColorPosition;
   write('Z'+chr(26));
   TextColor (BLACK);
   TextBackground (BLACK);
   write(' ');
   if ComputerTurn = FALSE then
      ColorDim
   else
      ColorCard;
   write (CardString (ComputerScorePile.SeeRandom(1)));
end; {procedure DrawHands}

{___________________________________________________________________
|  DrawAcePiles
|     One of the procedures involved with the interface.
|     This procedure draws the AcePile portion of the screen.
|__________________________________________________________________}

procedure DrawAcePiles;

var Counter: integer;

begin

   ColorNormalText;
   OutString (36,5,'Ace Piles:');
   ColorPosition;
   OutString (38,8,'L'+chr(26));
   OutString (38,9,'M'+chr(26));
   OutString (38,10,'N'+chr(26));
   OutString (38,11,'O'+chr(26));
   ColorCard;
   for Counter := 1 to 4 do begin
      OutString(41,7+Counter,CardString (TopCardTable [11+Counter] ));
      if CardValue( TopCardTable [11+Counter] )=0 then
         if AceTopCard (11+Counter) < 10 then
            OutString(45,7+Counter,chr(AceTopCard (11+Counter) + 48))
         else if AceTopCard (11+Counter) = 10 then
            OutString(45,7+Counter,'10')
         else if AceTopCard (11+Counter) = 11 then
            OutString(45,7+Counter,'JA')
         else if AceTopCard (11+Counter) = 12 then
            OutString(45,7+Counter,'QU')
         else if AceTopCard (11+Counter) = 13 then
            OutString(45,7+Counter,'KI');
   end; {for}
end; {Display}

{___________________________________________________________________
|  DrawMessageBox
|     One of the procedures involved with the interface.
|     This procedure clears the message portion of the screen and
|     prints a message displaying the turn.
|__________________________________________________________________}

procedure DrawMessageBox (ComputerTurn: boolean);

var
   Column: integer;
   Row: integer;

begin

   TextColor (BLACK);
   TextBackground (BLACK);
   for Column := 32 to 49 do
      for Row := 14 to 23 do
         OutString (Column,Row,chr(219));
   ColorNormalText;
   if ((ComputerTurn = TRUE) AND (TwoPlayer = FALSE)) then begin
      GotoXY (33,15);
      write ('Computer''s Turn');
   end
   else if ((ComputerTurn = TRUE) AND (TwoPlayer = TRUE)) then begin
      GotoXY (33,15);
      write ('Opponent''s Turn');
   end
   else begin
      GotoXY (34,15);
      write ('Player''s Turn');
   end;
end; {procedure DrawMessageBox}

{___________________________________________________________________
|  Display
|     This procedure directs the interface procedures for a complete
|     redrawing of the screen.
|__________________________________________________________________}

procedure Display;

begin
   clrscr;
   DrawFrame (ComputerTurn);
   DrawDiscards (ComputerTurn);
   DrawHands (ComputerTurn);
   DrawAcePiles;
   DrawMessageBox (ComputerTurn);
end; {Display}

{___________________________________________________________________
|  PickUpHand
|     Picks up the required number of cards from the draw pile and
|     places them in the hand of the person whose turn it is.
|     This procedure also checks to see if the draw pile has run out
|     of cards.  If so the trash pile is placed in the draw pile and
|     the draw pile is subsequently reshuffled.
|___________________________________________________________________}

Procedure PickupHand (var Hand : pile);

var numToGet, count, Counter : integer;

begin

   If (Hand.NumCards > 3)Then
      numToGet := 1
   Else
      numToGet := (5 - Hand.NumCards);

   For count := 1 to numToGet Do begin
      If DrawPile.NumCards = 0 then begin {Draw pile out of card, replenish}
         For Counter := 1 to TrashPile.NumCards do
            DrawPile.PutOnTop (TrashPile.RemoveFromTop);
         DrawPile.RandomShuffle;
      end; {if}
      Hand.PutOnTop (DrawPile.RemoveFromTop);
   end; {for}
end; {procedure PickupHand}

{____________________________________________________________________
|  PickUpCards
|     Sends correct hand to the PickupHand procedure according to
|     whose turn it is.
|___________________________________________________________________}

Procedure PickupCards;

begin
   If ComputerTurn Then
      PickupHand (ComputerHand)
   Else
      PickupHand (PlayerHand);

   InitTable; {Refresh the Top Card Table}
end; {PickupCards}

{____________________________________________________________________
|  HouseKeeping
|     Performs some checks after a card has been moved.
|     These checks include: removing completed ace piles,
|        checking for completed game, and checking for
|        insufficient cards to discard.
|___________________________________________________________________}

procedure HouseKeeping;

var Counter: integer;
    Counter2: integer;

begin

   InitTable; {Keep current top card information updated.}

   {Clean up any full ace piles.}

   for Counter := 12 to 15 do
      if PosTable [Counter]^.NumCards = 13 then
         for Counter2 := 1 to 13 do
            TrashPile.PutOnTop (PosTable [Counter]^.RemoveFromTop);

   {Check for Game over.}

   if ComputerScorePile.NumCards = 0 then
      begin
         Game := FALSE;
         Discard := TRUE;
         Winner := 'Computer';
      end; {if}

   if PlayerScorePile.NumCards = 0 then
      begin
         Game := FALSE;
         Discard := TRUE;
         Winner := 'Player';
      end; {if}

   {Run out of cards before discard.}

   If ((Discard = FALSE) AND ComputerTurn AND
       (ComputerHand.NumCards = 0)) then
      PickUpCards;
   If ((Discard = FALSE) AND (NOT ComputerTurn) AND
       (PlayerHand.NumCards = 0)) then
      PickUpCards;

end; {procedure HouseKeeping}

{____________________________________________________________________
|  MoveCard
|     Moves a card from one pile to another as specified.
|___________________________________________________________________}

Procedure MoveCard (From, Tto : integer);

var frompile : pilepointer_t;  value: CardVal_t;
    dummy: integer;

begin
  if ((From < 7) Or ((From > 19) AND (From < 26))) then begin
     frompile :=PosTable[From];
     value := TopCardTable[From];
     dummy := frompile^.DeleteByValue(value);
     PosTable[Tto]^.PutOnTop(value);
     end
  else
     PosTable[Tto]^.PutOnTop (PosTable[From]^.RemoveFromTop);

  HouseKeeping; {Calls the HouseKeeping procedure}
end; {procedure MoveCard}

{____________________________________________________________________
|  WhoseTurn
|     This procedure changes the turns.
|___________________________________________________________________}

Procedure WhoseTurn (var ComputerTurn : boolean);

begin
   If ComputerTurn Then
      ComputerTurn := False
   Else
      ComputerTurn := True;
end; {WhoseTurn}

{____________________________________________________________________
|  CheckMove
|     Checks to see if the move proposed is a) valid, and
|       b) a discard.
|___________________________________________________________________}

Procedure CheckMove(var From, Tto: integer);

var
   TopCard: integer;
   position: Pos_t;
   Counter: Pos_t;
   EmptyAcePile: boolean;

begin
   InitTable;
   Valid := TRUE;
   Discard := FALSE;
   MustMove := FALSE;


   If TopCardTable [From] = NULL then
      Valid := FALSE; {Invalid if moving from empty space.}
   If (Valid AND ((Tto < 8) OR (Tto > 19))) then
      Valid := FALSE;{Invalid if proposed to move card to ScorePiles or Hands}
   If (Valid AND ComputerTurn AND ((Tto < 12) OR (From < 12))) then
      Valid := FALSE; {Invalid if computer proposed to or from player's side.}
   If (VALID AND (NOT ComputerTurn) AND ((Tto > 15) OR (From > 15))) then
      Valid := FALSE; {Invalid if player proposed to or from computer's side.}
   If (VALID AND ((From > 11) AND (From < 16))) then
      Valid := FALSE; {Invalid if to Acepile from Acepile.}
   if (VALID AND (((Tto > 7) AND (Tto < 12)) OR ((Tto > 15) AND (Tto < 20)))
      AND (((From < 12) AND (From > 6)) OR ((From = 26) OR
      ((From > 15) AND (From < 20))))) then
      Valid := FALSE; {Invalid if to discard from a discard or score pile.}

   {Ace on top of Discard Pile must be played first.}

   EmptyAcePile := FALSE;
   for Counter := 1 to 4 do
      if PosTable [Counter + 11]^.NumCards = 0 then
         EmptyAcePile := TRUE;

   if (EmptyAcePile AND Valid) then
      for Counter := 1 to 4 do begin
         if ((ComputerTurn) AND (CardValue (TopCardTable [Counter + 15]) = 1)
           AND (From <> (Counter + 15))
           AND (NOT(CardValue(TopCardTable[From])=1))) then
            Valid := FALSE;
         if ((NOT ComputerTurn) AND (CardValue (TopCardTable[Counter+7]) = 1)
           AND (From <> (Counter + 7))
           AND (NOT(CardValue(TopCardTable[From])=1))) then
           Valid := FALSE;
      end; {for}

   if (EmptyAcePile AND Valid) then
      for Counter := 1 to 4 do begin
         if ((ComputerTurn) AND (CardValue (TopCardTable [Counter + 15]) = 1)
           AND (From = (Counter + 15))
           OR (CardValue(TopCardTable[From])=1)) then begin
            Valid := True;
            MustMove := True;
         end; {if}
      end; {for} {forces computer to play ace when
                   To/From scores below threshold}


   {Ace Piles Check}
   if (VALID AND ((Tto > 11) AND (Tto < 16))) then begin
      TopCard := AceTopCard (Tto);
      If ((TopCard = NULL) AND (CardValue (TopCardTable [From]) <> 1)) then
         Valid := FALSE {If placing non-ace on empty ace pile.}
      else if TopCard = NULL then
         Valid := TRUE
      else if CardValue(TopCardTable[From]) = 0 then
         Valid := TRUE {In all cases but as ace, joker is valid.}
      else if ((TopCard + 1) <> CardValue (TopCardTable[From])) then
         Valid := FALSE; {If it is not next card in series.}
   end; {if}

   {Discard Check}
   if (Valid AND ((ComputerTurn AND ((Tto < 20) AND (Tto > 15) AND (From > 19)
      AND (From < 26))) OR (NOT ComputerTurn AND ((Tto < 12) AND (Tto > 7)
      AND (From < 7) AND (From > 0))))) then
      if PosTable [Tto]^.NumCards > 0 then begin
         Discard := TRUE;
         if ComputerTurn then
            For Counter := 16 to 19 do
               if PosTable [Counter]^.NumCards = 0 then begin
                  Valid := FALSE;
                  Discard := FALSE;
               end; {if}
         if NOT ComputerTurn then
            For Counter := 8 to 11 do
               if PosTable [Counter]^.NumCards = 0 then begin
                  Valid := FALSE;
                  Discard := FALSE;
               end; {if}
      end; {if}
end;{CheckMove}

{____________________________________________________________________
|  GetMove
|     Requested a proposal for a move from the player.
|___________________________________________________________________}

Procedure GetMove (var From, Tto: integer);

var FromChar, ToChar: char;

begin
   Display;
   ColorNormalText;
   OutString (33,17,'Enter positions');
   ColorDim;
   OutString (35,18,'(@ to Quit)');
   ColorNormalText;
   OutString (33,19,'Move a card');
   OutString (33,20,'from: ');
   readln (FromChar);
   OutString (33,21,'to: ');
   readln (ToChar);
   From := ord(UpCase(FromChar)) - 64;
   Tto := ord(UpCase(ToChar)) - 64;

   {-64 to adjust for alphabet's position in ASCII table.}
   if ((From = 0) OR (Tto = 0)) then begin {quit}
      ColorNormalText;
      clrscr;
      HALT;
   end; {if}

   if ((From < 1) OR (From > 26) OR (Tto < 1) OR (From > 26)) then begin
      From := 1;
      Tto := 1;
   end; {if}

end; {GetMove}

{____________________________________________________________________
|  ResultsofCheck
|     Displays a message regarding the results of the check in
|     CheckMove.
|___________________________________________________________________}

procedure ResultsofCheck;

begin
   DrawMessageBox (ComputerTurn);    {Calls the DrawMessageBox procedure}
   ColorNormalText;
   OutString (33,17,'Proposed Move:');
   GotoXY (33,18);
   write ('From: ',chr(From + 64));
   GotoXY (33,19);
   write ('To: ',chr(Tto + 64));
   GotoXY (33,21);
   if NOT Valid then begin
      TextColor (WHITE+BLINK);
      write ('Is NOT Valid!!');
   end
   else begin
      TextColor (WHITE);
      write ('Is Valid.');
   end; {if else}
   TextColor (RED+BLINK);
   OutString (33,23,'Press <Enter>...');
   readln;
end; {ResultsofCheck}

{_____________________________________________________________________
|    PlayAgainBox
|     Displays Box and asks player if he/she wants to play again
|_____________________________________________________________________}
procedure PlayAgainBox;

Begin
 ColorNormalText;
 clrscr;
 DrawTitleBox;
 ColorNormalText;
 OutString (27, 11, 'Would you like to play again?');
 OutString (37, 12, '(');
 TextColor (LightRed);
 OutString (38, 12,  'Y ');
 TextColor (white);
 OutString (40, 12, 'or ');
 TextColor (lightRed);
 OutString (43, 12, 'N');
 TextColor (white);
 OutString (44, 12, ')');
End;

{____________________________________________________________________
|  GameOverDisplay
|     Notifies player that the game is over, displays who won, and
|     asks the player if he/she would like to play again.
|___________________________________________________________________}

Procedure GameOverDisplay (Winner: string);

var Response: char;
    Valid: boolean;

begin
   ColorNormalText;
   clrscr;
   DrawTitleBox;
   ColorNormalText;
   OutString (36, 10, 'Game Over!!');
   OutString (32, 12, 'The ');
   OutString (36, 12, Winner);
   OutString (44, 12,  ' wins!');
   readln;
   {Play Again?}
   Valid := FALSE;
   Repeat
      PlayAgainBox;
      readln (Response);
      if (Upcase (Response) = 'Y') then begin
         AnotherGame := TRUE;
         Valid := TRUE;
      end
      else
      if (Upcase (Response) = 'N') then begin
         AnotherGame := FALSE;
         Valid := TRUE;
      end
      else
      Valid := FALSE;
   Until Valid;
end; {function AnotherGame}

{___________________________________________________________________
|  SetUp
|     One of Decision's evaluative functions.
|     This function adds a negative weight if a play will result in
|     setting up the player to play from his/her score pile.
|__________________________________________________________________}

Function SetUp: integer;

const
   WEIGHT = -20;
   SWEIGHT =-10;

var
   position: integer;
   Points: integer;
   CardCanPlay: integer;
   ScoreCard: integer;
   CardPlayed: integer;

begin
   Points := 0;
   ScoreCard := CardValue (TopCardTable [7]);
   CardPlayed := AceTopCard (Tto) + 1;
   CardCanPlay := CardPlayed + 1;
   If CardCanPlay  = ScoreCard then begin
      Points := WEIGHT;
      For position := 16 to 26 do begin
         if CardValue (TopCardTable [position]) = ScoreCard then
            Points := 0;
         if position = From then
            if CardValue (PosTable [position]^.SeeRandom(2)) = ScoreCard then
               Points := 0;
      end; {for}
   end; {if}
   If (Points = WEIGHT) AND (From = 26) then
    Points := SWEIGHT;

   SetUp := Points;
end; {function SetUp}

{___________________________________________________________________
|  Block
|    One of Decision's evaluative functions.
|    This function adds a positive weight if the play results in
|    preventing the player from playing from his score pile.
|__________________________________________________________________}

function Block: integer;

const
   WEIGHT = 25;

var
   Points: integer;
   ScoreCard: integer;
   CardPlayed: integer;

begin
   Points := 0;
   ScoreCard := CardValue (TopCardTable [7]);
   CardPlayed := AceTopCard (Tto) + 1;
   If CardPlayed = ScoreCard then
      Points := WEIGHT;
   Block := points;
end; {Block}

{___________________________________________________________________
|  PlayMore
|    One of Decision's evaluative functions.
|    This function adds a positive weight if a play results in the
|    computer being able to play more cards.
|    It also adds a positive weight if a play allows the computer to
|    move a card.
|___________________________________________________________________}

function PlayMore: integer;

const
   WEIGHT = 15;  {If move allows the computer to move more cards.}
   WEIGHT2 = 10; {If Computer can move a card.}
var
   position: integer;
   Points: integer;
   CardCanPlay: integer;
   CardPlayed: integer;

begin
   Points := WEIGHT2; {Just for being able to play a card.}
   CardPlayed := AceTopCard (Tto) + 1;
   CardCanPlay := CardPlayed + 1;

   position := 16;
   While (Position < 27) do begin
      if CardValue (TopCardTable [position]) = CardCanPlay then
         Points := WEIGHT;
      if position = From then
         if CardValue(PosTable [position]^.SeeRandom (2)) = CardCanPlay then
            Points := WEIGHT;
      position := position + 1;
   end; {While}

        {Special case for Jokers}
   If CardValue (TopCardTable [From]) = 0 then
      Points := Points - WEIGHT;
   PlayMore := Points;
end; {function PlayMore}

{____________________________________________________________________
|  MoreCards
|     One of Decision's evaluative functions
|     This function adds weight to a play that will result in the
|     computer being able to pick up more cards at the beginning of
|     its next turn.  Additional weight is given to a play that will
|     result in the computer being able to pick up 5 more cards this
|     turn.
|____________________________________________________________________}

function MoreCards: integer;

const WEIGHT = 10;
      WEIGHT2 = 20;

var HolestoFill: integer;
    Counter: integer;
    Points: integer;

begin
   Points := 0;

               {creates empty discard pile, ie a hole to fill}
   If ((From >15) AND (From <20) AND (PosTable [From]^.NumCards = 1) AND
       (NOT CardValue(TopCardTable [From]) = 0)) then
      Points := WEIGHT;

             {takes into account the holes}
   HolestoFill := 0;
   If ((From > 19) AND (From < 26 )) then begin
      Points := WEIGHT;
      For Counter := 16 to 19 do begin
         If PosTable [Counter]^.NumCards = 0 then
            HolestoFill := HolestoFill + 1;
      end; {for}
      If (ComputerHand.NumCards - HolestoFill) = 0 then
          Points := WEIGHT2;

                 {special case for Jokers}
      If CardValue (TopCardTable [From]) = 0 then
          Points := Points - WEIGHT;
   end; {if}
   MoreCards := Points;
end; {MoreCards}

{_____________________________________________________________________
|  HelpScore
|     One of Decision's evaluative functions
|     This function will add positive weight to a play that results
|     in the computer being able to play from its score pile.
|____________________________________________________________________}

function HelpScore: integer;

const WEIGHT = 30;

var ScoreCard: integer;
    CardPlayed: integer;
    CardCanPlay: integer;
    Points: integer;

begin
   Points := 0;
   ScoreCard := CardValue (TopCardTable [26]);
   CardPlayed := AceTopCard (Tto) + 1;
   CardCanPlay := CardPlayed + 1;
   If CardCanPlay  = ScoreCard then
      Points := WEIGHT;
   HelpScore := Points;
end; {function HelpScore}

{_____________________________________________________________________
|  Score
|     One of Decision's evaluative functions.
|     This function adds positive weight to a score pile play.
|____________________________________________________________________}

function Score: integer;

const WEIGHT = 60;
      WEIGHT2 = 10;

var ScoreCard: integer;
    position: integer;
    Points: integer;

Begin
 Points := 0;
 if From = 26 then begin
   ScoreCard := CardValue (TopCardTable [26]);
   if (((AceTopCard (Tto) + 1) = ScoreCard) OR (ScoreCard = 0)) then begin
         Points := WEIGHT;
         if ((ScoreCard + 1) = CardValue (TopCardTable [7])) then begin
            Points := WEIGHT2;
            position := 16;
            while (position < 26) do begin
               position := position + 1;
               if ((TopCardTable [position] = 0)  OR
                   (TopCardTable [position] = (ScoreCard +1))) then
                   Points := WEIGHT;
            end; {While}
         end; {if}
   end; {if}
 end; {if}
 Score := Points;
end; {function Score}

{_____________________________________________________________________
|  SameScore
|     One of DiscardDecision's evaluative functions
|     This function adds a negative weight to a discard
|     of a card that is the same value as the computer's score
|     pile.
|____________________________________________________________________}

function SameScore: integer;

const WEIGHT = -5;
      JWEIGHT = -20;

var Points: integer;

begin
   Points := 0;
   If (CardValue(TopCardTable[From]) = CardValue (TopCardTable[26])) then
      Points := WEIGHT;

             {special case for Jokers}
   If CardValue (TopCardTable[From]) = 0 then
      Points := JWEIGHT;

   SameScore := Points;
end; {function SameScore}

{_____________________________________________________________________
|  Order
|     One of DecisionDiscard's evaluative functions
|     This function uses weights to prioritize a discard to the closest
|     possible lower value in relation to the top cards of the discard
|     piles.
|____________________________________________________________________}

function Order: integer;

const WEIGHT1 = 20;
      WEIGHT2 = 11;
      WEIGHT3 = 4;
      WEIGHT4 = -5;
      JWEIGHT = -20;

var next: CardVal_t;
    Points: integer;

begin

   next := CardValue (TopCardTable [Tto]) - 1;
   if (CardValue (TopCardTable [From]) = next)
      then Points := WEIGHT1;
   if ((CardValue (TopCardTable [From]) + 1) = next)
      then Points := WEIGHT2;
   if ((CardValue (TopCardTable[From]) + 1) < next)
      then Points := WEIGHT3;
   if (CardValue (TopCardTable [From]) > next)
      then Points := WEIGHT4;

      {special case for Jokers}
   if CardValue (TopCardTable [From]) = 0 then
      Points := JWEIGHT;

   Order := Points;
end; {Order}

{_____________________________________________________________________
|  HighCard
|     One of DecisionDiscard's evaluative functions.
|        This function weights the possible cards to fill in a space
|        in the discard piles.  It adds most weight to the highest
|        valued card.
|____________________________________________________________________}

function HighCard: integer;

var count, Points: integer;

begin
   Points := 0;
   if ((PosTable [16]^.NumCards = 0) OR (PosTable [17]^.NumCards = 0) OR
      (PosTable [18]^.NumCards = 0) OR (PosTable [19]^.NumCards = 0)) then
      for count := 20 to 25 do
         if (CardValue(TopCardTable [From]) >
            CardValue (TopCardTable [count])) then
            Points := Points + 1;
   HighCard := Points * 2;
end; {function HighCard}

{_____________________________________________________________________
|  DiscardDecision
|     This procedure is responsible for applying the various weights
|     on to the decision surrounding the computer's discard.
|____________________________________________________________________}

Procedure DiscardDecision (var From, Tto: integer);

var max: integer;
    f, t: integer;

Begin

   For f := 20 to 25 Do
      For t := 16 to 19 Do begin
         From := f;
         Tto := t;
      CheckMove (From, Tto);
      If Not (Valid) Then
         ChoiceRate[f, t] := -10000
      Else
         ChoiceRate[f, t] := ((HighCard) + (Order) + (SameScore));
      end; {for}

   From := 20;
   Tto := 16;
   max := 0;
   For f := 20 to 25 Do
      For t := 16 to 19 Do  begin
         If (ChoiceRate[f, t] > ChoiceRate[From, Tto]) Then  begin
            max := ChoiceRate[f, t];
            From := f;
            Tto := t;
         end; {if}
      end; {for}
End; {DiscardDecision}

{_____________________________________________________________________
|  Decision
|     This procedure is responsible for applying the weights to the
|     decision surrounding the computer's choice of moves.
|____________________________________________________________________}

Procedure Decision (var From, Tto: integer);

const Threshold = 10;

var Max: integer;
    f, t: integer;
Begin
   Display;
   For f := 1 to 26 do
      For t := 1 to 19 do
         ChoiceRate [f, t] := 0;

   For f := 16 to 26 Do
      For t := 12 to 15 Do begin
         From := f;
         Tto := t;
         CheckMove(From, Tto);
         If Not (Valid) Then
            ChoiceRate[f, t] := -10000
         Else
            ChoiceRate[f, t] := ((SetUp) + (Block) +
            (PlayMore) + (MoreCards) + (HelpScore) + (Score));
   end; {for}

   {Tests Threshold}
   From := 16;
   Tto := 12;
   max := 0;
   For f := 16 to 26 Do
      For t := 12 to 15 Do  begin
         If (ChoiceRate[f, t] > ChoiceRate[From, Tto]) Then  begin
            max := ChoiceRate[f, t];
            From := f;
            Tto := t;
         end; {if}
      end; {for}
   If (Max < Threshold) AND (NOT(MustMove)) Then
      DiscardDecision (From, Tto);

End; {Decision}

{============================================================================
                                 MAIN PROGRAM
============================================================================}


BEGIN {Main Program}
   Repeat
      TitleScreen (TwoPlayer);
      Initialize;
      Deal;
      While (Game) Do begin
            WhoseTurn (ComputerTurn);
            PickupCards;
            Repeat
                  If ((ComputerTurn) AND (NOT TwoPlayer)) Then
                      Decision (From, Tto)
                  Else
                      GetMove (From, Tto);
                  CheckMove(From, Tto);
                  ResultsofCheck;
                  If Valid then
                     MoveCard (From, Tto);
            Until (Discard);
      End; {While Loop}
      GameOverDisplay (Winner);
   Until (NOT AnotherGame);
END. {Main Program}